home *** CD-ROM | disk | FTP | other *** search
/ Nebula 1 / Nebula One.iso / Internet / WWW / Perl_WWW_Utilities / perlMIF_beta2 / xrgb2mif < prev   
Encoding:
Text File  |  1994-06-07  |  2.2 KB  |  67 lines
  1. #! /usr/local/bin/perl
  2. ##---------------------------------------------------------------------------##
  3. ##  File:
  4. ##      xrgb2mif
  5. ##  Author:
  6. ##      Earl Hood       ehood@convex.com
  7. ##  Description:
  8. ##    xrgb2mif is a Perl program to convert X colors in the format
  9. ##    of the rgb.txt file and convert it to a Frame MIF color catalog.
  10. ##
  11. ##    Usage:
  12. ##        xrgb2mif file1 file2 ... > xcolors.mif
  13. ##        xrgb2mif < rgb.txt > xcolors.mif
  14. ##
  15. ##  Notes:
  16. ##    xrgb2mif makes use of the "mif", "mif_id", and "mif_colc" libraries
  17. ##    to generate the MIF.
  18. ##
  19. ##---------------------------------------------------------------------------##
  20. ##  Copyright (C) 1994  Earl Hood, ehood@convex.com
  21. ##
  22. ##  This program is free software; you can redistribute it and/or modify
  23. ##  it under the terms of the GNU General Public License as published by
  24. ##  the Free Software Foundation; either version 2 of the License, or
  25. ##  (at your option) any later version.
  26. ##  
  27. ##  This program is distributed in the hope that it will be useful,
  28. ##  but WITHOUT ANY WARRANTY; without even the implied warranty of
  29. ##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  30. ##  GNU General Public License for more details.
  31. ##  
  32. ##  You should have received a copy of the GNU General Public License
  33. ##  along with this program; if not, write to the Free Software
  34. ##  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  35. ##---------------------------------------------------------------------------##
  36.  
  37. require 'mif/mif.pl' || die "Unable to require mif.pl\n";
  38. require 'mif/mif_id.pl' || die "Unable to require mif_id.pl\n";
  39. require 'mif/mif_colc.pl' || die "Unable to require mif_colc.pl\n";
  40.  
  41. package main;
  42.  
  43. sub min {
  44.     local($x, $y, $z) = @_;
  45.     $x < $y ? ($x < $z ? $x : $z)
  46.         : ($y < $z ? $y : $z);
  47. }
  48.  
  49. while (<>) {
  50.     $xtra = "";
  51.     ($R, $G, $B, $color, $xtra) = split(' ', $_, 5);
  52.     next if $xtra;            # Skip multi-word color names
  53.  
  54.     ($C, $M, $Y) = (1.0-$R/255, 1.0-$G/255, 1.0-$B/255);
  55.     $K = &min($C, $M, $Y);
  56.     $C -= $K; $M -= $K; $Y -= $K;
  57.     &MIFset_color_data($color,
  58.                sprintf("%.6f", $'C*100.0),
  59.                sprintf("%.6f", $'M*100.0),
  60.                sprintf("%.6f", $'Y*100.0),
  61.                sprintf("%.6f", $'K*100.0));
  62. }
  63. &MIFwrite_mif_id(STDOUT);
  64. &MIFwrite_colc(STDOUT);
  65.  
  66. exit 0;
  67.